unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

const
  H = 120;
  N = 25000;

type
  frfrfr= record
    t: integer;
    f: boolean;
    arr: array [0.. n] of integer;
  end;
  TForm1 = class(TForm)
    Timer1: TTimer;
    Button1: TButton;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Swap (a, b: integer);
    procedure Heapify (num: integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  memory: integer;
  sf2: boolean;
  bs, abs, s, hs: frfrfr;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  randomize;
  Timer1.Enabled:= true;
  Button1.Visible:= false;
  label1.Left:= Form1.ClientWidth-Label1.Width;
  Label1.Top:= Form1.ClientHeight-Label1.Height;
  Label1.Visible:= true;
  bs.t:= 0;
  abs.t:= 0;
  s.t:= 0;
  hs.t:= 0;
end;

procedure TForm1.Heapify(num: integer);
var
  x, a, b: Integer;
begin
  while (1=1) do
  begin
    x := hs.arr[num];
    a := 2000000000;
    b := a;
    if (2*num + 1 <= memory) then
      a := hs.arr[2*num+1];
    if (2*num  <= memory) then
      b := hs.arr[2*num];
    if (a <= b) and (a < x) then
    begin
      hs.arr[num]:= a;
      hs.arr[2*num+1] := x;
      num := 2*num + 1;
    end else
    if (b <= a) and (b < x) then
    begin
      hs.arr[num]:= b;
      hs.arr[2*num]:= x;
      num := 2*num;
    end else
      break;
  end;
end;

procedure TForm1.Swap(a, b: integer);
var t: integer;
begin
  t:= a;
  a:= b;
  b:= t;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var i, j, max, t: integer; alpha: real;
begin
  for i := 0 to n - 1 do
  begin
    bs.arr[i]:= random (n);
    abs.arr[i]:= bs.arr[i];
    s.arr[i]:= bs.arr[i];
    hs.arr[i]:= bs.arr[i];
  end;

  //BubbleSort
  t:= GetTickCount;
  for j:= 1 to n-1 do
    for i:= 0 to n-j-1 do
      if (bs.arr[i]>bs.arr[i+1]) then
        swap (bs.arr[i], bs.arr[i+1]);
  bs.t:=bs.t+GetTickCount-t;

  //Advanced BubbleSort
  t:= GetTickCount;
  for j:= 0 to n-1 do
  begin
    abs.f:= true;
    for i:= 0 to n-j-1 do
      if (abs.arr[i]>abs.arr[i+1]) then
      begin
        swap(abs.arr[i], abs.arr[i+1]);
        abs.f:= false;
      end;
    if (abs.f) then
        break;
  end;
  abs.t:= abs.t+GetTickCount-t;

  //Shaker
  t:= GetTickCount;
  for j:= 0 to (n div 2)-1 do
  begin
    s.f:= true;
    for i:= j to n-j do
      if (s.arr[i]>s.arr[i+1]) then
      begin
        swap (s.arr[i], s.arr[i+1]);
        s.f:= false;
      end;
    for i:= n-j downto j do
      if (s.arr[i]>s.arr[i+1]) then
      begin
        swap (s.arr[i], s.arr[i+1]);
        s.f:= false;
      end;
    if (s.f) then
      break;
  end;
  s.t:= s.t+GetTickCount-t;

  //HeapSort
  t:= GetTickCount;
  for i := n-1 downto 0 do
    Heapify(i);
  memory:= n;
  for i := 0 to n-1 do
  begin
    swap (hs.arr[0], hs.arr[memory]);
    dec (memory);
    Heapify(0);
  end;
  hs.t:= hs.t+GetTickCount-t;

  max:= bs.t;
  if max<abs.t then
    max:= abs.t;
  if max<s.t then
    max:= s.t;
  if max<hs.t then
    max:= hs.t;
  if max=0 then
    max:= 1;
  alpha:= (Form1.Width-Canvas.TextWidth('Advanced BubbleSort, mc '+ IntToStr(abs.t))-10)/max;
  if (alpha=0) then
    alpha:= 1;

  Canvas.Brush.Color:= clWhite;
  Canvas.Pen.Color:= clWhite;
  Canvas.Rectangle(Form1.ClientRect);
  Canvas.TextOut (round(alpha*bs.t), h-10, 'BubbleSort, mc '+ IntToStr(bs.t));
  Canvas.TextOut (round(alpha*abs.t), 2*h, 'Advanced BubbleSort, mc '+ IntToStr(abs.t));
  Canvas.TextOut (round(alpha*s.t), 3*h+10, 'Shaker, mc '+ IntToStr(s.t));
  Canvas.TextOut (round(alpha*hs.t), 4*h+20, 'HeapSort, mc '+ IntToStr(hs.t));
  Canvas.Brush.Color:= clGreen;
  Canvas.Pen.Color:= clGreen;
  Canvas.Rectangle (0, 0, round(alpha*bs.t), h);
  Canvas.Rectangle (0, h+10, round(alpha*abs.t), 2*h+10);
  Canvas.Rectangle (0, 2*(h+10), round(alpha*s.t), 3*h+20);
  Canvas.Rectangle (0, 3*(h+10), round(alpha*hs.t), 4*h+30);
end;

end.
